home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / byte0687.arc / BROUKE.ARC / LISTING3.BAS < prev    next >
Encoding:
BASIC Source File  |  1987-03-12  |  1.7 KB  |  43 lines
  1. «RHA«PT3»«MDNM»«LS1»«LM2»«RM78»«FL»
  2. ARTICLE #508046«LD »PAGE «PN»
  3. «LD_»
  4.  
  5.  
  6. »«LS2»«LM7»«FL»«SSMATH,fc»«SSPAR,IP5,0»«SSFPAR,IP0,0»«SSCAPTIONS,ls1,IP0,MDRV»«SSDECK,MDBO»«SSCOLQUOTE,RM37,MDRV»«SSBYLINE,MDBO»«SSHEAD,MDBO»«SSSUBH,IP0,MDBO»«SSLISTING,PT1,lm7,RM63,IP0,15,LS1»«SSHANG,IP0,2»«SSBIO,MDRV»«USLISTING»CLS: PRINT "CONREC example. Graph the equipotential lines"
  7. print "around two charg particles by contouring the function"
  8. print: print "V(x,y)=q1/r1 - q2/r2"
  9. print "letting x and y range from -4 to 4."
  10. OPTION BASE 0 'Lower bound of zero for all array indices
  11. pi=3.141592654#
  12. true=-1 : false=0
  13. ilength=319 : jlength=199    'Dimensions of the output contour plot axes (full screen in CGA mode)
  14. imin=0  :jmin=199    'Coordinates of the left bottom corner
  15. iub=30 : jub=30 : nc=8 'Number of grid intervals and contour levels
  16. DIM d(iub,jub),x(iub),y(jub)    'Data array
  17. DIM z(nc-1)    'Contour array
  18. REM
  19. REM    Define the function and the coordinates
  20. a=1.5 : q1=1 : q2=-4  'Charge q1 is at -a; q2 is at +a
  21. FOR i=0 TO iub
  22.     ix=4*(2*i-iub)/iub   'Range from -4 to 4
  23.     FOR j=0 TO jub
  24.         jy=4*(2*j-jub)/jub  'Range from -4 to 4
  25.         r1=SQR((ix-a)^2+jy^2)
  26.         r2=SQR((ix+a)^2+jy^2)
  27.         d(i,j)=(q1/r1-q2/r2)
  28.     NEXT j
  29.     x(i)=i*ilength/iub+imin  'Scale x(i) to span plot area
  30. NEXT i
  31. FOR j=0 TO jub
  32.     y(j)=jmin-j*jlength/jub  'Scale y(i) to span plot area
  33. NEXT j
  34. FOR i=0 TO nc-1 : z(i)=(i+1)/2 : NEXT i
  35. REM
  36. CLS: SCREEN 1,0    'CGA screen 320 x 200
  37. LINE(imin,jmin-jlength)-(imin+ilength,jmin),,b 'Use a box for axes
  38. GOSUB conrec
  39. IF NOT(prmerr) THEN PRINT : PRINT : PRINT msg$;
  40. WHILE LEN(INKEY$)=0 : WEND    'Any key to stop
  41. CLS : WINDOW CLOSE 1
  42. END
  43.